library(tidyverse)
library(rlang)
library(leaflet)
library(purrr)
library(tigris)
library(fs)

https://data.medicare.gov/Hospital-Compare/Structural-Measures-Hospital/4hje-vua3

hospitals_raw <- read_csv("../data/Structural_Measures_-_Hospital.csv")
Parsed with column specification:
cols(
  `Provider ID` = col_character(),
  `Hospital Name` = col_character(),
  Address = col_character(),
  City = col_character(),
  State = col_character(),
  `ZIP Code` = col_character(),
  `County Name` = col_character(),
  `Phone Number` = col_character(),
  `Measure Name` = col_character(),
  `Measure ID` = col_character(),
  `Measure Response` = col_character(),
  Footnote = col_character(),
  `Measure Start Date` = col_character(),
  `Measure End Date` = col_character(),
  Location = col_character()
)
hospitals <- hospitals_raw %>%
  rename_all(str_to_lower) %>%
  rename_all(str_replace_all, " ", "_") %>%
  select(provider_id, hospital_name, state, county_name, location) %>%
  group_by_all() %>%
  summarise() %>%
  ungroup() %>%
  separate(location, into = c("address", "location"), sep = "\\(") %>%
  mutate(location = str_remove(location, "\\)")) %>%
  separate(location, into = c("latitude", "longitude"), sep = ",") %>%
  mutate(
    longitude = as.numeric(longitude), latitude = as.numeric(latitude),
    county_key = str_remove_all(county_name, " County"),
    county_key = str_remove_all(county_key, " Parish"),
    county_key = str_remove_all(county_key, " city"),
    county_key = str_to_lower(county_key),
    county_key = str_remove_all(county_key, " "),
    county_key = str_replace_all(county_key, "st. ", "saint"))  
Expected 2 pieces. Additional pieces discarded in 1 rows [161].Expected 2 pieces. Missing pieces filled with `NA` in 352 rows [2, 7, 71, 88, 97, 100, 103, 106, 108, 109, 139, 140, 141, 142, 145, 179, 182, 194, 201, 212, ...].NAs introduced by coercionNAs introduced by coercion
hospitals
hospital_locations <- hospitals  %>%
  filter(!is.na(longitude)) %>%
  select(state, longitude, latitude)
write_rds(hospital_locations, "../data/hospital_locations.rds")
hospital_locations
population <- usmap::countypop %>%
  mutate(
    county_key = str_remove_all(county, " County"),
    county_key = str_remove_all(county_key, " Parish"),
    county_key = str_remove_all(county_key, " city"),
    county_key = str_to_lower(county_key),
    county_key = str_remove_all(county_key, " "),
    county_key = str_replace_all(county_key, "st. ", "saint")) %>%
  rename(
    population = pop_2015,
    state = abbr
    )
population
hospital_count <- hospitals %>%
  count(state, county_name) %>%
  filter(!is.na(county_name)) %>%
  mutate(
    county_key = str_remove_all(county_name, " County"),
    county_key = str_remove_all(county_key, " Parish"),
    county_key = str_remove_all(county_key, " city"),
    county_key = str_to_lower(county_key),
    county_key = str_remove_all(county_key, " "),
    county_key = str_replace_all(county_key, "st.", "saint")) %>%
  rename(hospitals = n)
hospital_count
state_hospitals <- population %>%
  left_join(hospital_count, by = c("state" = "state", "county_key" = "county_key")) %>%
  replace_na(list(hospitals = 0)) 
state_hospitals
set.seed(100)

hospital_sample <- state_hospitals %>%
  sample_frac(0.3)

hospital_sample
model <- lm(hospitals ~ population, data = hospital_sample)
write_rds(model, "../data/model.rds")
summary(model)

Call:
lm(formula = hospitals ~ population, data = hospital_sample)

Residuals:
    Min      1Q  Median      3Q     Max 
-9.6459 -0.6562  0.1462  0.3342  8.6451 

Coefficients:
             Estimate Std. Error t value Pr(>|t|)    
(Intercept) 6.121e-01  4.327e-02   14.14   <2e-16 ***
population  7.587e-06  1.297e-07   58.48   <2e-16 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 1.262 on 941 degrees of freedom
Multiple R-squared:  0.7842,    Adjusted R-squared:  0.784 
F-statistic:  3420 on 1 and 941 DF,  p-value: < 2.2e-16
predictions <- predict(model, 
  newdata = state_hospitals, 
  interval = "prediction") %>%
  as_tibble() %>%
  mutate_all(round)

predictions
hospital_results <- state_hospitals %>%
  bind_cols(predictions) %>%
  mutate(result = case_when(
    hospitals < lwr ~ -1,
    hospitals > upr ~ 1,
    TRUE ~ 0))
write_rds(hospital_results, "../data/hospitals.rds")

hospital_results 

State map

dir_create("shapes")
all_paths <- path("../shapes", state.abb, ext = "rds") %>%
  set_names(state.abb)

exist <- file_exists(all_paths)

county_paths <- all_paths[!exist]

imap(
  county_paths,
  ~ counties(.y) %>%
    write_rds(.x)
)
named list()
select_row <- function(x, y) x %% y == 0

extract_coordinates <- function(path, decimals = 2) {
  state_rds <- readRDS(path)
  state_rds@polygons %>%
    map(~ {
      map(
        .x@Polygons,
        ~ tibble(
          long = .x@coords[, 1],
          lat = .x@coords[, 2],
          rn = 1:length(.x@coords[, 1]),
          sel = select_row(rn, 10)
        )) %>% 
        set_names(paste0("s", seq_along(.x@Polygons))) %>%
        map_df(~.x, .id = "shape_id")}) %>%
    set_names(state_rds$NAME) %>%
    map_df(~.x, .id = "county") %>%
    filter(sel) %>%
    select(-rn, -sel)
}

county_states <- map_dfr(
  all_paths,
  extract_coordinates,
  .id = "state"
) 

nested_states <- county_states %>%
  group_nest(state, county, shape_id) %>%
  group_nest(state, county)

write_rds(nested_states, "../data/shapes.rds", compress = "gz")
shapes <- nested_states %>%
  mutate(
    county_key = str_to_lower(county),
    county_key = str_remove_all(county_key, " "),
    county_key = str_replace_all(county_key, "st. ", "saint")
  ) 

shapes 
county_hospitals <- hospital_results  %>%
  select(- county) %>%
  left_join(shapes, by = c("state", "county_key")) %>%
  #filter(state != "PR", state != "AK") %>%
  filter(!is.na(county))

write_rds(county_hospitals, "../data/county_hospitals.rds", compress = "gz")

county_hospitals
library(usmap)

state_abbr <- "VA"

under <- "#CC79A7"
over <- "#0072B2"
at_level <- "#008b00"
hospital_color <- "#F0E442"

counties <- county_hospitals %>% 
    filter(state == state_abbr) %>%
    mutate(popup = paste0("<b>", county, "</b>",
                          "<br/>Population: ", prettyNum(population, big.mark = ","), 
                          "<br/>Hospitals: ", hospitals,
                          "<br/>Expected: ", fit
                          )) %>%  
    mutate(color = case_when(
      result ==  0  ~ at_level,
      result ==  1  ~ over,
      result == -1  ~ under
    ))

initial_map <- leaflet() %>%
  addProviderTiles(providers$CartoDB) %>%
  addLegend("bottomright", 
            color  = c(under,over ,at_level, hospital_color), 
            labels = c("Less hopitals than expected",
                       "More hospitals than expected", "Within Range", 
                       "Hospital Location"), 
            title  = "Legend",opacity = 0.5)

county_map <- counties %>%
  transpose() %>%
  map(~{
    county <- .x
     transpose(county$data)  %>%
       map(~list(
         data = .x$data, 
         color = county$color,
         popup = county$popup
         ))
    }) %>%
  flatten() %>%
  reduce(
    ~ addPolygons(.x, 
                  lng = .y$data$long, 
                  lat = .y$data$lat, 
                  color = .y$color, 
                  popup = .y$popup,
                  weight = 1, fillOpacity = 0.3), 
    .init = initial_map)  

locations <- hospital_locations %>%
  inner_join(statepop, by = c("state" = "abbr")) %>%
  filter(state == state_abbr) %>%
  select(longitude, latitude) %>%
  mutate_all(round, 3) %>%
  count(longitude, latitude) %>%
  mutate(popup = paste0("Hospitals: ", n))

county_map <- county_map %>%
  addCircleMarkers(
    lng = locations$longitude, 
    lat = locations$latitude,
    radius = 3 *locations$n,
    popup = locations$popup,
    fillColor = hospital_color, color = "gray", 
    fillOpacity = 0.7,weight = 1)

county_map  
library(fs)

path("..","data", c("county_hospitals.rds", "hospital_locations.rds", "model.rds")) %>%
  file_copy("../flexdashboard", overwrite = TRUE)

path("..","data", c("county_hospitals.rds", "hospital_locations.rds", "model.rds")) %>%
  file_copy("../presentation", overwrite = TRUE)

path("..","data", c("county_hospitals.rds", "hospital_locations.rds")) %>%
  file_copy("../RMarkdown-html", overwrite = TRUE)

path("..","data", c("county_hospitals.rds", "hospital_locations.rds")) %>%
  file_copy("../RMarkdown-pdf", overwrite = TRUE)

path("..","data", c("model.rds", "hospitals.rds", "hospital_locations.rds")) %>%
  file_copy("../plumber-api", overwrite = TRUE)

path("..","data", c("model.rds", "county_hospitals.rds")) %>%
  file_copy("../powerpoint", overwrite = TRUE)

path("..","data", c("model.rds", "county_hospitals.rds")) %>%
  file_copy("../powerpoint-state", overwrite = TRUE)
LS0tDQp0aXRsZTogIkFjY2VzcyB0byBDYXJlIEFuYWx5c2lzIg0Kb3V0cHV0OiBodG1sX25vdGVib29rDQotLS0NCg0KYGBge3IsIGluY2x1ZGUgPSBGQUxTRX0NCmxpYnJhcnkodGlkeXZlcnNlKQ0KbGlicmFyeShybGFuZykNCmxpYnJhcnkobGVhZmxldCkNCmxpYnJhcnkocHVycnIpDQpsaWJyYXJ5KHRpZ3JpcykNCmxpYnJhcnkoZnMpDQpgYGANCg0KYGBge3IsIGV2YWwgPSBGQUxTRX0NCmxpYnJhcnkodGlkeXZlcnNlKQ0KbGlicmFyeShybGFuZykNCmxpYnJhcnkobGVhZmxldCkNCmxpYnJhcnkocHVycnIpDQpsaWJyYXJ5KHRpZ3JpcykNCmxpYnJhcnkoZnMpDQpgYGANCg0KaHR0cHM6Ly9kYXRhLm1lZGljYXJlLmdvdi9Ib3NwaXRhbC1Db21wYXJlL1N0cnVjdHVyYWwtTWVhc3VyZXMtSG9zcGl0YWwvNGhqZS12dWEzDQoNCmBgYHtyfQ0KaG9zcGl0YWxzX3JhdyA8LSByZWFkX2NzdigiLi4vZGF0YS9TdHJ1Y3R1cmFsX01lYXN1cmVzXy1fSG9zcGl0YWwuY3N2IikNCmBgYCANCg0KYGBge3J9DQpob3NwaXRhbHMgPC0gaG9zcGl0YWxzX3JhdyAlPiUNCiAgcmVuYW1lX2FsbChzdHJfdG9fbG93ZXIpICU+JQ0KICByZW5hbWVfYWxsKHN0cl9yZXBsYWNlX2FsbCwgIiAiLCAiXyIpICU+JQ0KICBzZWxlY3QocHJvdmlkZXJfaWQsIGhvc3BpdGFsX25hbWUsIHN0YXRlLCBjb3VudHlfbmFtZSwgbG9jYXRpb24pICU+JQ0KICBncm91cF9ieV9hbGwoKSAlPiUNCiAgc3VtbWFyaXNlKCkgJT4lDQogIHVuZ3JvdXAoKSAlPiUNCiAgc2VwYXJhdGUobG9jYXRpb24sIGludG8gPSBjKCJhZGRyZXNzIiwgImxvY2F0aW9uIiksIHNlcCA9ICJcXCgiKSAlPiUNCiAgbXV0YXRlKGxvY2F0aW9uID0gc3RyX3JlbW92ZShsb2NhdGlvbiwgIlxcKSIpKSAlPiUNCiAgc2VwYXJhdGUobG9jYXRpb24sIGludG8gPSBjKCJsYXRpdHVkZSIsICJsb25naXR1ZGUiKSwgc2VwID0gIiwiKSAlPiUNCiAgbXV0YXRlKA0KICAgIGxvbmdpdHVkZSA9IGFzLm51bWVyaWMobG9uZ2l0dWRlKSwgbGF0aXR1ZGUgPSBhcy5udW1lcmljKGxhdGl0dWRlKSwNCiAgICBjb3VudHlfa2V5ID0gc3RyX3JlbW92ZV9hbGwoY291bnR5X25hbWUsICIgQ291bnR5IiksDQogICAgY291bnR5X2tleSA9IHN0cl9yZW1vdmVfYWxsKGNvdW50eV9rZXksICIgUGFyaXNoIiksDQogICAgY291bnR5X2tleSA9IHN0cl9yZW1vdmVfYWxsKGNvdW50eV9rZXksICIgY2l0eSIpLA0KICAgIGNvdW50eV9rZXkgPSBzdHJfdG9fbG93ZXIoY291bnR5X2tleSksDQogICAgY291bnR5X2tleSA9IHN0cl9yZW1vdmVfYWxsKGNvdW50eV9rZXksICIgIiksDQogICAgY291bnR5X2tleSA9IHN0cl9yZXBsYWNlX2FsbChjb3VudHlfa2V5LCAic3QuICIsICJzYWludCIpKSAgDQoNCmBgYA0KDQpgYGB7cn0NCmhvc3BpdGFscw0KYGBgDQoNCmBgYHtyfQ0KaG9zcGl0YWxfbG9jYXRpb25zIDwtIGhvc3BpdGFscyAgJT4lDQogIGZpbHRlcighaXMubmEobG9uZ2l0dWRlKSkgJT4lDQogIHNlbGVjdChzdGF0ZSwgbG9uZ2l0dWRlLCBsYXRpdHVkZSkNCndyaXRlX3Jkcyhob3NwaXRhbF9sb2NhdGlvbnMsICIuLi9kYXRhL2hvc3BpdGFsX2xvY2F0aW9ucy5yZHMiKQ0KaG9zcGl0YWxfbG9jYXRpb25zDQpgYGANCg0KYGBge3J9DQpwb3B1bGF0aW9uIDwtIHVzbWFwOjpjb3VudHlwb3AgJT4lDQogIG11dGF0ZSgNCiAgICBjb3VudHlfa2V5ID0gc3RyX3JlbW92ZV9hbGwoY291bnR5LCAiIENvdW50eSIpLA0KICAgIGNvdW50eV9rZXkgPSBzdHJfcmVtb3ZlX2FsbChjb3VudHlfa2V5LCAiIFBhcmlzaCIpLA0KICAgIGNvdW50eV9rZXkgPSBzdHJfcmVtb3ZlX2FsbChjb3VudHlfa2V5LCAiIGNpdHkiKSwNCiAgICBjb3VudHlfa2V5ID0gc3RyX3RvX2xvd2VyKGNvdW50eV9rZXkpLA0KICAgIGNvdW50eV9rZXkgPSBzdHJfcmVtb3ZlX2FsbChjb3VudHlfa2V5LCAiICIpLA0KICAgIGNvdW50eV9rZXkgPSBzdHJfcmVwbGFjZV9hbGwoY291bnR5X2tleSwgInN0LiAiLCAic2FpbnQiKSkgJT4lDQogIHJlbmFtZSgNCiAgICBwb3B1bGF0aW9uID0gcG9wXzIwMTUsDQogICAgc3RhdGUgPSBhYmJyDQogICAgKQ0KcG9wdWxhdGlvbg0KYGBgDQoNCg0KYGBge3J9DQpob3NwaXRhbF9jb3VudCA8LSBob3NwaXRhbHMgJT4lDQogIGNvdW50KHN0YXRlLCBjb3VudHlfbmFtZSkgJT4lDQogIGZpbHRlcighaXMubmEoY291bnR5X25hbWUpKSAlPiUNCiAgbXV0YXRlKA0KICAgIGNvdW50eV9rZXkgPSBzdHJfcmVtb3ZlX2FsbChjb3VudHlfbmFtZSwgIiBDb3VudHkiKSwNCiAgICBjb3VudHlfa2V5ID0gc3RyX3JlbW92ZV9hbGwoY291bnR5X2tleSwgIiBQYXJpc2giKSwNCiAgICBjb3VudHlfa2V5ID0gc3RyX3JlbW92ZV9hbGwoY291bnR5X2tleSwgIiBjaXR5IiksDQogICAgY291bnR5X2tleSA9IHN0cl90b19sb3dlcihjb3VudHlfa2V5KSwNCiAgICBjb3VudHlfa2V5ID0gc3RyX3JlbW92ZV9hbGwoY291bnR5X2tleSwgIiAiKSwNCiAgICBjb3VudHlfa2V5ID0gc3RyX3JlcGxhY2VfYWxsKGNvdW50eV9rZXksICJzdC4iLCAic2FpbnQiKSkgJT4lDQogIHJlbmFtZShob3NwaXRhbHMgPSBuKQ0KaG9zcGl0YWxfY291bnQNCmBgYA0KDQoNCmBgYHtyfQ0Kc3RhdGVfaG9zcGl0YWxzIDwtIHBvcHVsYXRpb24gJT4lDQogIGxlZnRfam9pbihob3NwaXRhbF9jb3VudCwgYnkgPSBjKCJzdGF0ZSIgPSAic3RhdGUiLCAiY291bnR5X2tleSIgPSAiY291bnR5X2tleSIpKSAlPiUNCiAgcmVwbGFjZV9uYShsaXN0KGhvc3BpdGFscyA9IDApKSANCnN0YXRlX2hvc3BpdGFscw0KYGBgDQoNCmBgYHtyfQ0Kc2V0LnNlZWQoMTAwKQ0KDQpob3NwaXRhbF9zYW1wbGUgPC0gc3RhdGVfaG9zcGl0YWxzICU+JQ0KICBzYW1wbGVfZnJhYygwLjMpDQoNCmhvc3BpdGFsX3NhbXBsZQ0KYGBgDQoNCmBgYHtyfQ0KbW9kZWwgPC0gbG0oaG9zcGl0YWxzIH4gcG9wdWxhdGlvbiwgZGF0YSA9IGhvc3BpdGFsX3NhbXBsZSkNCndyaXRlX3Jkcyhtb2RlbCwgIi4uL2RhdGEvbW9kZWwucmRzIikNCnN1bW1hcnkobW9kZWwpDQpgYGANCg0KYGBge3J9DQpwcmVkaWN0aW9ucyA8LSBwcmVkaWN0KG1vZGVsLCANCiAgbmV3ZGF0YSA9IHN0YXRlX2hvc3BpdGFscywgDQogIGludGVydmFsID0gInByZWRpY3Rpb24iKSAlPiUNCiAgYXNfdGliYmxlKCkgJT4lDQogIG11dGF0ZV9hbGwocm91bmQpDQoNCnByZWRpY3Rpb25zDQpgYGANCg0KYGBge3J9DQpob3NwaXRhbF9yZXN1bHRzIDwtIHN0YXRlX2hvc3BpdGFscyAlPiUNCiAgYmluZF9jb2xzKHByZWRpY3Rpb25zKSAlPiUNCiAgbXV0YXRlKHJlc3VsdCA9IGNhc2Vfd2hlbigNCiAgICBob3NwaXRhbHMgPCBsd3IgfiAtMSwNCiAgICBob3NwaXRhbHMgPiB1cHIgfiAxLA0KICAgIFRSVUUgfiAwKSkNCndyaXRlX3Jkcyhob3NwaXRhbF9yZXN1bHRzLCAiLi4vZGF0YS9ob3NwaXRhbHMucmRzIikNCg0KaG9zcGl0YWxfcmVzdWx0cyANCmBgYA0KDQojIyBTdGF0ZSBtYXANCg0KYGBge3J9DQpkaXJfY3JlYXRlKCJzaGFwZXMiKQ0KYWxsX3BhdGhzIDwtIHBhdGgoIi4uL3NoYXBlcyIsIHN0YXRlLmFiYiwgZXh0ID0gInJkcyIpICU+JQ0KICBzZXRfbmFtZXMoc3RhdGUuYWJiKQ0KDQpleGlzdCA8LSBmaWxlX2V4aXN0cyhhbGxfcGF0aHMpDQoNCmNvdW50eV9wYXRocyA8LSBhbGxfcGF0aHNbIWV4aXN0XQ0KDQppbWFwKA0KICBjb3VudHlfcGF0aHMsDQogIH4gY291bnRpZXMoLnkpICU+JQ0KICAgIHdyaXRlX3JkcygueCkNCikNCg0Kc2VsZWN0X3JvdyA8LSBmdW5jdGlvbih4LCB5KSB4ICUlIHkgPT0gMA0KDQpleHRyYWN0X2Nvb3JkaW5hdGVzIDwtIGZ1bmN0aW9uKHBhdGgsIGRlY2ltYWxzID0gMikgew0KICBzdGF0ZV9yZHMgPC0gcmVhZFJEUyhwYXRoKQ0KICBzdGF0ZV9yZHNAcG9seWdvbnMgJT4lDQogICAgbWFwKH4gew0KICAgICAgbWFwKA0KICAgICAgICAueEBQb2x5Z29ucywNCiAgICAgICAgfiB0aWJibGUoDQogICAgICAgICAgbG9uZyA9IC54QGNvb3Jkc1ssIDFdLA0KICAgICAgICAgIGxhdCA9IC54QGNvb3Jkc1ssIDJdLA0KICAgICAgICAgIHJuID0gMTpsZW5ndGgoLnhAY29vcmRzWywgMV0pLA0KICAgICAgICAgIHNlbCA9IHNlbGVjdF9yb3cocm4sIDEwKQ0KICAgICAgICApKSAlPiUgDQogICAgICAgIHNldF9uYW1lcyhwYXN0ZTAoInMiLCBzZXFfYWxvbmcoLnhAUG9seWdvbnMpKSkgJT4lDQogICAgICAgIG1hcF9kZih+LngsIC5pZCA9ICJzaGFwZV9pZCIpfSkgJT4lDQogICAgc2V0X25hbWVzKHN0YXRlX3JkcyROQU1FKSAlPiUNCiAgICBtYXBfZGYofi54LCAuaWQgPSAiY291bnR5IikgJT4lDQogICAgZmlsdGVyKHNlbCkgJT4lDQogICAgc2VsZWN0KC1ybiwgLXNlbCkNCn0NCg0KY291bnR5X3N0YXRlcyA8LSBtYXBfZGZyKA0KICBhbGxfcGF0aHMsDQogIGV4dHJhY3RfY29vcmRpbmF0ZXMsDQogIC5pZCA9ICJzdGF0ZSINCikgDQoNCm5lc3RlZF9zdGF0ZXMgPC0gY291bnR5X3N0YXRlcyAlPiUNCiAgZ3JvdXBfbmVzdChzdGF0ZSwgY291bnR5LCBzaGFwZV9pZCkgJT4lDQogIGdyb3VwX25lc3Qoc3RhdGUsIGNvdW50eSkNCg0Kd3JpdGVfcmRzKG5lc3RlZF9zdGF0ZXMsICIuLi9kYXRhL3NoYXBlcy5yZHMiLCBjb21wcmVzcyA9ICJneiIpDQpgYGANCg0KDQpgYGB7cn0NCnNoYXBlcyA8LSBuZXN0ZWRfc3RhdGVzICU+JQ0KICBtdXRhdGUoDQogICAgY291bnR5X2tleSA9IHN0cl90b19sb3dlcihjb3VudHkpLA0KICAgIGNvdW50eV9rZXkgPSBzdHJfcmVtb3ZlX2FsbChjb3VudHlfa2V5LCAiICIpLA0KICAgIGNvdW50eV9rZXkgPSBzdHJfcmVwbGFjZV9hbGwoY291bnR5X2tleSwgInN0LiAiLCAic2FpbnQiKQ0KICApIA0KDQpzaGFwZXMgDQpgYGANCg0KYGBge3J9DQpjb3VudHlfaG9zcGl0YWxzIDwtIGhvc3BpdGFsX3Jlc3VsdHMgICU+JQ0KICBzZWxlY3QoLSBjb3VudHkpICU+JQ0KICBsZWZ0X2pvaW4oc2hhcGVzLCBieSA9IGMoInN0YXRlIiwgImNvdW50eV9rZXkiKSkgJT4lDQogICNmaWx0ZXIoc3RhdGUgIT0gIlBSIiwgc3RhdGUgIT0gIkFLIikgJT4lDQogIGZpbHRlcighaXMubmEoY291bnR5KSkNCg0Kd3JpdGVfcmRzKGNvdW50eV9ob3NwaXRhbHMsICIuLi9kYXRhL2NvdW50eV9ob3NwaXRhbHMucmRzIiwgY29tcHJlc3MgPSAiZ3oiKQ0KDQpjb3VudHlfaG9zcGl0YWxzDQpgYGANCg0KYGBge3J9DQpsaWJyYXJ5KHVzbWFwKQ0KDQpzdGF0ZV9hYmJyIDwtICJWQSINCg0KdW5kZXIgPC0gIiNDQzc5QTciDQpvdmVyIDwtICIjMDA3MkIyIg0KYXRfbGV2ZWwgPC0gIiMwMDhiMDAiDQpob3NwaXRhbF9jb2xvciA8LSAiI0YwRTQ0MiINCg0KY291bnRpZXMgPC0gY291bnR5X2hvc3BpdGFscyAlPiUgDQogICAgZmlsdGVyKHN0YXRlID09IHN0YXRlX2FiYnIpICU+JQ0KICAgIG11dGF0ZShwb3B1cCA9IHBhc3RlMCgiPGI+IiwgY291bnR5LCAiPC9iPiIsDQogICAgICAgICAgICAgICAgICAgICAgICAgICI8YnIvPlBvcHVsYXRpb246ICIsIHByZXR0eU51bShwb3B1bGF0aW9uLCBiaWcubWFyayA9ICIsIiksIA0KICAgICAgICAgICAgICAgICAgICAgICAgICAiPGJyLz5Ib3NwaXRhbHM6ICIsIGhvc3BpdGFscywNCiAgICAgICAgICAgICAgICAgICAgICAgICAgIjxici8+RXhwZWN0ZWQ6ICIsIGZpdA0KICAgICAgICAgICAgICAgICAgICAgICAgICApKSAlPiUgIA0KICAgIG11dGF0ZShjb2xvciA9IGNhc2Vfd2hlbigNCiAgICAgIHJlc3VsdCA9PSAgMCAgfiBhdF9sZXZlbCwNCiAgICAgIHJlc3VsdCA9PSAgMSAgfiBvdmVyLA0KICAgICAgcmVzdWx0ID09IC0xICB+IHVuZGVyDQogICAgKSkNCg0KaW5pdGlhbF9tYXAgPC0gbGVhZmxldCgpICU+JQ0KICBhZGRQcm92aWRlclRpbGVzKHByb3ZpZGVycyRDYXJ0b0RCKSAlPiUNCiAgYWRkTGVnZW5kKCJib3R0b21yaWdodCIsIA0KICAgICAgICAgICAgY29sb3IgID0gYyh1bmRlcixvdmVyICxhdF9sZXZlbCwgaG9zcGl0YWxfY29sb3IpLCANCiAgICAgICAgICAgIGxhYmVscyA9IGMoIkxlc3MgaG9waXRhbHMgdGhhbiBleHBlY3RlZCIsDQogICAgICAgICAgICAgICAgICAgICAgICJNb3JlIGhvc3BpdGFscyB0aGFuIGV4cGVjdGVkIiwgIldpdGhpbiBSYW5nZSIsIA0KICAgICAgICAgICAgICAgICAgICAgICAiSG9zcGl0YWwgTG9jYXRpb24iKSwgDQogICAgICAgICAgICB0aXRsZSAgPSAiTGVnZW5kIixvcGFjaXR5ID0gMC41KQ0KDQpjb3VudHlfbWFwIDwtIGNvdW50aWVzICU+JQ0KICB0cmFuc3Bvc2UoKSAlPiUNCiAgbWFwKH57DQogICAgY291bnR5IDwtIC54DQogICAgIHRyYW5zcG9zZShjb3VudHkkZGF0YSkgICU+JQ0KICAgICAgIG1hcCh+bGlzdCgNCiAgICAgICAgIGRhdGEgPSAueCRkYXRhLCANCiAgICAgICAgIGNvbG9yID0gY291bnR5JGNvbG9yLA0KICAgICAgICAgcG9wdXAgPSBjb3VudHkkcG9wdXANCiAgICAgICAgICkpDQogICAgfSkgJT4lDQogIGZsYXR0ZW4oKSAlPiUNCiAgcmVkdWNlKA0KICAgIH4gYWRkUG9seWdvbnMoLngsIA0KICAgICAgICAgICAgICAgICAgbG5nID0gLnkkZGF0YSRsb25nLCANCiAgICAgICAgICAgICAgICAgIGxhdCA9IC55JGRhdGEkbGF0LCANCiAgICAgICAgICAgICAgICAgIGNvbG9yID0gLnkkY29sb3IsIA0KICAgICAgICAgICAgICAgICAgcG9wdXAgPSAueSRwb3B1cCwNCiAgICAgICAgICAgICAgICAgIHdlaWdodCA9IDEsIGZpbGxPcGFjaXR5ID0gMC4zKSwgDQogICAgLmluaXQgPSBpbml0aWFsX21hcCkgIA0KDQpsb2NhdGlvbnMgPC0gaG9zcGl0YWxfbG9jYXRpb25zICU+JQ0KICBpbm5lcl9qb2luKHN0YXRlcG9wLCBieSA9IGMoInN0YXRlIiA9ICJhYmJyIikpICU+JQ0KICBmaWx0ZXIoc3RhdGUgPT0gc3RhdGVfYWJicikgJT4lDQogIHNlbGVjdChsb25naXR1ZGUsIGxhdGl0dWRlKSAlPiUNCiAgbXV0YXRlX2FsbChyb3VuZCwgMykgJT4lDQogIGNvdW50KGxvbmdpdHVkZSwgbGF0aXR1ZGUpICU+JQ0KICBtdXRhdGUocG9wdXAgPSBwYXN0ZTAoIkhvc3BpdGFsczogIiwgbikpDQoNCmNvdW50eV9tYXAgPC0gY291bnR5X21hcCAlPiUNCiAgYWRkQ2lyY2xlTWFya2VycygNCiAgICBsbmcgPSBsb2NhdGlvbnMkbG9uZ2l0dWRlLCANCiAgICBsYXQgPSBsb2NhdGlvbnMkbGF0aXR1ZGUsDQogICAgcmFkaXVzID0gMyAqbG9jYXRpb25zJG4sDQogICAgcG9wdXAgPSBsb2NhdGlvbnMkcG9wdXAsDQogICAgZmlsbENvbG9yID0gaG9zcGl0YWxfY29sb3IsIGNvbG9yID0gImdyYXkiLCANCiAgICBmaWxsT3BhY2l0eSA9IDAuNyx3ZWlnaHQgPSAxKQ0KDQpjb3VudHlfbWFwICANCmBgYA0KDQoNCmBgYHtyfQ0KbGlicmFyeShmcykNCg0KcGF0aCgiLi4iLCJkYXRhIiwgYygiY291bnR5X2hvc3BpdGFscy5yZHMiLCAiaG9zcGl0YWxfbG9jYXRpb25zLnJkcyIsICJtb2RlbC5yZHMiKSkgJT4lDQogIGZpbGVfY29weSgiLi4vZmxleGRhc2hib2FyZCIsIG92ZXJ3cml0ZSA9IFRSVUUpDQoNCnBhdGgoIi4uIiwiZGF0YSIsIGMoImNvdW50eV9ob3NwaXRhbHMucmRzIiwgImhvc3BpdGFsX2xvY2F0aW9ucy5yZHMiLCAibW9kZWwucmRzIikpICU+JQ0KICBmaWxlX2NvcHkoIi4uL3ByZXNlbnRhdGlvbiIsIG92ZXJ3cml0ZSA9IFRSVUUpDQoNCnBhdGgoIi4uIiwiZGF0YSIsIGMoImNvdW50eV9ob3NwaXRhbHMucmRzIiwgImhvc3BpdGFsX2xvY2F0aW9ucy5yZHMiKSkgJT4lDQogIGZpbGVfY29weSgiLi4vUk1hcmtkb3duLWh0bWwiLCBvdmVyd3JpdGUgPSBUUlVFKQ0KDQpwYXRoKCIuLiIsImRhdGEiLCBjKCJjb3VudHlfaG9zcGl0YWxzLnJkcyIsICJob3NwaXRhbF9sb2NhdGlvbnMucmRzIikpICU+JQ0KICBmaWxlX2NvcHkoIi4uL1JNYXJrZG93bi1wZGYiLCBvdmVyd3JpdGUgPSBUUlVFKQ0KDQpwYXRoKCIuLiIsImRhdGEiLCBjKCJtb2RlbC5yZHMiLCAiaG9zcGl0YWxzLnJkcyIsICJob3NwaXRhbF9sb2NhdGlvbnMucmRzIikpICU+JQ0KICBmaWxlX2NvcHkoIi4uL3BsdW1iZXItYXBpIiwgb3ZlcndyaXRlID0gVFJVRSkNCg0KcGF0aCgiLi4iLCJkYXRhIiwgYygibW9kZWwucmRzIiwgImNvdW50eV9ob3NwaXRhbHMucmRzIikpICU+JQ0KICBmaWxlX2NvcHkoIi4uL3Bvd2VycG9pbnQiLCBvdmVyd3JpdGUgPSBUUlVFKQ0KDQpwYXRoKCIuLiIsImRhdGEiLCBjKCJtb2RlbC5yZHMiLCAiY291bnR5X2hvc3BpdGFscy5yZHMiKSkgJT4lDQogIGZpbGVfY29weSgiLi4vcG93ZXJwb2ludC1zdGF0ZSIsIG92ZXJ3cml0ZSA9IFRSVUUpDQoNCg0KYGBgDQoNCg==